'    This is a part of the source code for Pro/DESKTOP.
'    Copyright (C) 1998-1999 Parametric Technology Corporation.
'    All rights reserved.


'Subroutine to create Support Plate

Sub SupportPlate()

    Dim app As Object
    Set app = CreateObject("ProDESKTOP.Application")
    
    'Take the helm
    Dim api As helm
    Set api = app.TakeHelm
    
    Dim part As PartDocument
    Set part = app.NewPart()
    
    Dim design As aDesign
    Set design = part.GetDesign
    
    Dim workplaneSet As ObjectSet
    Set workplaneSet = design.GetWorkplanes
    
    Dim Frontalworkplane As aWorkplane
    
    Dim baseworkplane As aWorkplane
    Dim lateralworkplane As aWorkplane
    
    Set baseworkplane = part.LookupWorkplane("base")
    Set Frontalworkplane = part.LookupWorkplane("frontal")
    Set lateralworkplane = part.LookupWorkplane("lateral")
    
    Set sketch = Frontalworkplane.CreateSketch("BasicSketch")
    part.SetActiveSketch sketch
    
    Set sketch = part.GetActiveSketch
    
    Dim vector1 As zVector
    Dim vector2 As zVector
    Dim vector3 As zVector
    Dim vector4 As zVector
    Dim vector5 As zVector
    Dim vector6 As zVector
    Dim vector7 As zVector
    Dim vector8 As zVector
    Dim vector9 As zVector
    Dim vector10 As zVector
    Dim vector11 As zVector
    Dim vector12 As zVector
    
    Set vector1 = app.GetClass("Vector").CreateVector(-0.024, 0, 0.08)
    Set vector2 = app.GetClass("Vector").CreateVector(0.0385, 0, 0.08)
    Set vector3 = app.GetClass("Vector").CreateVector(0.0385, 0, -0.083)
    Set vector4 = app.GetClass("Vector").CreateVector(0.026, 0, -0.083)
    Set vector5 = app.GetClass("Vector").CreateVector(0.026, 0, -0.2685)
    Set vector6 = app.GetClass("Vector").CreateVector(0.1035, 0, -0.2685)
    Set vector7 = app.GetClass("Vector").CreateVector(0.1035, 0, -0.306)
    Set vector8 = app.GetClass("Vector").CreateVector(-0.0465, 0, -0.306)
    Set vector9 = app.GetClass("Vector").CreateVector(-0.0465, 0, -0.2685)
    Set vector10 = app.GetClass("Vector").CreateVector(-0.0115, 0, -0.2685)
    Set vector11 = app.GetClass("Vector").CreateVector(-0.0115, 0, -0.083)
    Set vector12 = app.GetClass("Vector").CreateVector(-0.024, 0, -0.083)
    
    Dim curve1 As zCurve
    Dim curve2 As zCurve
    Dim curve3 As zCurve
    Dim curve4 As zCurve
    Dim curve5 As zCurve
    Dim curve6 As zCurve
    Dim curve7 As zCurve
    Dim curve8 As zCurve
    Dim curve9 As zCurve
    Dim curve10 As zCurve
    Dim curve11 As zCurve
    Dim curve12 As zCurve
    
    Dim line1 As aLine
    Dim line2 As aLine
    Dim line3 As aLine
    Dim line4 As aLine
    Dim line5 As aLine
    Dim line6 As aLine
    Dim line7 As aLine
    Dim line8 As aLine
    Dim line9 As aLine
    Dim line10 As aLine
    Dim line11 As aLine
    Dim line12 As aLine
    
    Set curve1 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector1, vector2)
    Set line1 = sketch.CreateLine(curve1)
    
    Set curve2 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector2, vector3)
    Set line2 = sketch.CreateLine(curve2)
    
    Set curve3 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector3, vector4)
    Set line3 = sketch.CreateLine(curve3)
    
    Set curve4 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector4, vector5)
    Set line4 = sketch.CreateLine(curve4)
    
    Set curve5 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector5, vector6)
    Set line5 = sketch.CreateLine(curve5)
    
    Set curve6 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector6, vector7)
    Set line6 = sketch.CreateLine(curve6)
    
    Set curve7 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector7, vector8)
    Set line7 = sketch.CreateLine(curve7)
    
    Set curve8 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector8, vector9)
    Set line8 = sketch.CreateLine(curve8)
    
    Set curve9 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector9, vector10)
    Set line9 = sketch.CreateLine(curve9)
    
    Set curve10 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector10, vector11)
    Set line10 = sketch.CreateLine(curve10)
    
    Set curve11 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector11, vector12)
    Set line11 = sketch.CreateLine(curve11)
    
    Set curve12 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(vector12, vector1)
    Set line12 = sketch.CreateLine(curve12)
    
    'Create Extrusion1
    Dim extrusion1 As aOperation
    Set extrusion1 = app.GetClass("Extrusion").CreateExtrusion(part.GetDesign, sketch, 0.2, 0, 0, 0, 1, 0)
    extrusion1.SetName "Extrusion1"
    part.UpdateDesign
    
    part.SetState (5)
    
    Dim FaceSet As ObjectSet
    Set FaceSet = design.GetFacesOfOperation(extrusion1)
    
    Dim faceSetIt As Iterator
    Set faceSetIt = app.GetClass("it").CreateAObjectIt(FaceSet)
    
    Set face0 = faceSetIt.start
    Set face1 = faceSetIt.Next
    Set face2 = faceSetIt.Next
    Set face3 = faceSetIt.Next
    Set face4 = faceSetIt.Next
    Set face5 = faceSetIt.Next
    
    Set face6 = faceSetIt.Next
    Set face7 = faceSetIt.Next
    Set face8 = faceSetIt.Next
    Set face9 = faceSetIt.Next
    Set face10 = faceSetIt.Next
    
    part.SetSelection face10
    
    'Create a Workplane dspaceWp2
      
    Dim geom As zGeometry
    Set geom = face10.GetGeometricForm
    
    Dim Topyplane As zPlane
    Set Topyplane = geom
    
    Dim refplane2 As aWorkplane
    Set refplane2 = part.GetDesign.CreateWorkplane(Topyplane, "dspaceWP2")
    
    Dim Hole1 As aSketch
    Set Hole1 = refplane2.CreateSketch("ProfileSketch")
    
    part.SetActiveSketch Hole1
    
    Set vector1 = app.GetClass("Vector").CreateVector(0, 0#, 0)
    Set localcenter1 = part.GetActiveWorkplane.Get3DVector(vector1)
    
    Dim Plane3 As zPlane
    Set Plane3 = part.GetActiveWorkplane.GetGeometry
    Dim radius As Double
    
    radius = 0.05265
    Dim curve100 As zBasicCircle
    Set curve100 = app.GetClass("BasicCircle").CreateBasicCircle(localcenter1, Plane3.GetNormal, radius)
    
    part.SetState 1
    Dim circle1 As aLine
    Set circle1 = part.GetActiveSketch.CreateLine(curve100)
    
    Dim face100 As ObjectSet
    Dim projection3 As aOperation
    Set faceSet2 = app.GetClass("ObjectSet").CreateAObjectSet
    Set projection3 = app.GetClass("Projection").CreateProjection(part.GetDesign, part.GetActiveSketch, faceSet2, 1, 1, 0, 0, 2, 0)
    projection3.SetName "Projection1"
    part.UpdateDesign
    
    Dim profileWorkplane As aWorkplane
    Dim ProfileSketch As aSketch
    Set profileWorkplane = part.GetActiveWorkplane
    
    Set ProfileSketch = part.GetActiveWorkplane.CreateSketch("NewSketch")
    part.SetActiveSketch ProfileSketch
    
    Set vector1 = app.GetClass("Vector").CreateVector(-0.1, -0.267, 0)
    Set localvector1 = part.GetActiveWorkplane.Get3DVector(vector1)
    
    Set vector2 = app.GetClass("Vector").CreateVector(-0.1, 0.0815, 0)
    Set localvector2 = part.GetActiveWorkplane.Get3DVector(vector2)
    
    Set vector3 = app.GetClass("Vector").CreateVector(0#, 0.0815, 0)
    Set localvector3 = part.GetActiveWorkplane.Get3DVector(vector3)
    
    Set vector4 = app.GetClass("Vector").CreateVector(-0.081309063993, 0.005575492132, 0)
    Set localvector4 = part.GetActiveWorkplane.Get3DVector(vector4)
    
    Set curve1 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(localvector1, localvector2)
    Set line1 = part.GetActiveSketch.CreateLine(curve1)
    
    
    Dim newlineset As ObjectSet
    Set newlineset = part.GetActiveSketch.GetLines(True, True)
    
    newlineset.AddMember line1
    
    Set curve2 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(localvector2, localvector3)
    Set line2 = part.GetActiveSketch.CreateLine(curve2)
    
    newlineset.AddMember line2
    
    Dim curve400 As zBasicCircularArc
    Set vector5 = app.GetClass("Vector").CreateVector(0, 0, 0)
    Set localcenter5 = part.GetActiveWorkplane.Get3DVector(vector5)
    Dim plane5 As zPlane
    Set plane5 = part.GetActiveWorkplane.GetGeometry
    Set curve400 = app.GetClass("BasicCircularArc").CreateBasicCircularArc(localcenter5, plane5.GetNormal, 0.0815, localvector3, localvector4)
    Dim Circle4 As aLine
    Set Circle4 = part.GetActiveSketch.CreateLine(curve400)
    
    newlineset.AddMember Circle4
    
    Set curve4 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(localvector4, localvector1)
    Set line4 = part.GetActiveSketch.CreateLine(curve4)
    
    newlineset.AddMember line4
    
    Dim projection5 As aOperation
    Set projection5 = app.GetClass("Projection").CreateProjection(part.GetDesign, part.GetActiveSketch, faceSet2, 1, 1, 0, 0, 2, 0)
    projection5.SetName "Projection5"
    part.UpdateDesign
    
    Set profile2 = part.GetActiveWorkplane.CreateSketch("profile2")
    part.SetActiveSketch profile2
    
    Set mvector1 = app.GetClass("Vector").CreateVector(0.1, -0.267, 0)
    Set mlocalvector1 = part.GetActiveWorkplane.Get3DVector(mvector1)
    Set mvector2 = app.GetClass("Vector").CreateVector(0.1, 0.0815, 0)
    Set mlocalvector2 = part.GetActiveWorkplane.Get3DVector(mvector2)
    Set mvector3 = app.GetClass("Vector").CreateVector(0#, 0.0815, 0)
    Set mlocalvector3 = part.GetActiveWorkplane.Get3DVector(mvector3)
    Set mvector4 = app.GetClass("Vector").CreateVector(0.081309063993, 0.005575492132, 0)
    Set mlocalvector4 = part.GetActiveWorkplane.Get3DVector(mvector4)
    
    Set mcurve1 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(mlocalvector1, mlocalvector2)
    Set mline1 = part.GetActiveSketch.CreateLine(mcurve1)
    
    Set mcurve2 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(mlocalvector2, mlocalvector3)
    Set mline2 = part.GetActiveSketch.CreateLine(mcurve2)
    
    Dim mcurve400 As zBasicCircularArc
    Set mvector5 = app.GetClass("Vector").CreateVector(0, 0, 0)
    Set mlocalcenter5 = part.GetActiveWorkplane.Get3DVector(mvector5)
    Dim mplane5 As zPlane
    Set mplane5 = part.GetActiveWorkplane.GetGeometry
    Set mcurve400 = app.GetClass("BasicCircularArc").CreateBasicCircularArc(mlocalcenter5, mplane5.GetNormal.GetNegative.GetDirection, 0.0815, mlocalvector3, mlocalvector4)
    Dim mCircle4 As aLine
    Set mCircle4 = part.GetActiveSketch.CreateLine(mcurve400)
    
    Set mcurve4 = app.GetClass("BasicStraight").CreateBasicStraightTwoPoints(mlocalvector4, mlocalvector1)
    Set mline4 = part.GetActiveSketch.CreateLine(mcurve4)
    
    Dim projection6 As aOperation
    Set projection6 = app.GetClass("Projection").CreateProjection(part.GetDesign, part.GetActiveSketch, faceSet2, 1, 1, 0, 0, 2, 0)
    projection6.SetName "Projection6"
    part.UpdateDesign
    
    part.SetState (5)
       
    part.SetSelection face7
    
    Dim geom2 As zGeometry
    Set geom2 = face7.GetGeometricForm
    
    Dim Topyplane2 As zPlane
    Set Topyplane2 = geom2
    
    Dim refplane3 As aWorkplane
    Set refplane3 = part.GetDesign.CreateWorkplane(Topyplane2, "dspaceWP3")
    
    Dim Hole2 As aSketch
    Set Hole2 = refplane3.CreateSketch("ProfileSketch2")
    part.SetActiveSketch Hole2
    
    Set vector1 = app.GetClass("Vector").CreateVector(0#, -0.07, 0)
    Set localcenter1 = part.GetActiveWorkplane.Get3DVector(vector1)
    
    Set vector2 = app.GetClass("Vector").CreateVector(0#, 0.07, 0)
    Set localcenter2 = part.GetActiveWorkplane.Get3DVector(vector2)
    
    Dim Plane9 As zPlane
    Set Plane9 = part.GetActiveWorkplane.GetGeometry
    
    Set curve9 = app.GetClass("BasicCircle").CreateBasicCircle(localcenter1, Plane9.GetNormal, 0.0125)
    Dim Circle2 As aLine
    Set Circle2 = part.GetActiveSketch.CreateLine(curve9)
    
    Set curve3 = app.GetClass("BasicCircle").CreateBasicCircle(localcenter2, Plane9.GetNormal, 0.0125)
    Dim Circle3 As aLine
    Set Circle3 = part.GetActiveSketch.CreateLine(curve3)
    
    Dim projection400 As aOperation
    Set projection400 = app.GetClass("Projection").CreateProjection(part.GetDesign, part.GetActiveSketch, faceSet2, 1, 1, 0, 0, 2, 0)
    projection400.SetName "Projection10"
    part.UpdateDesign
    
    api.CommitCalls "SupportPlate", pause

End Sub



